Abstract

The reports looks at progression of COVID-19 within OECD countries and the overall magnitude of governments’ response to the pandemic.

Environment

library(ggplot2) #For graphing
library(magrittr) #Pipes
library(dplyr) # for shorter function names. but still prefer dplyr:: stems
library(knitr) # dynamic documents
library(rmarkdown) # dynamic
library(kableExtra) # enhanced tables, see http://haozhu233.github.io/kableExtra/awesome_table_in_html.html
# library(TabularManifest) # exploratory data analysis, see https://github.com/Melinae/TabularManifest
requireNamespace("knitr", quietly=TRUE)
requireNamespace("scales", quietly=TRUE) #For formating values in graphs
requireNamespace("RColorBrewer", quietly=TRUE)
requireNamespace("dplyr", quietly=TRUE)
requireNamespace("DT", quietly=TRUE) # for dynamic tables
# requireNamespace("plyr", quietly=TRUE)
# requireNamespace("reshape2", quietly=TRUE) #For converting wide to long
# requireNamespace("mgcv, quietly=TRUE) #For the Generalized Additive Model that smooths the longitudinal graphs.
config <- config::get()
source("./scripts/common-functions.R")        # reporting functions and quick views
# source("./scripts/graphing/graph-presets.R") # font and color conventions
# source("./scripts/graphing/graph-support.R") # font and color conventions
ggplot2::theme_set(
  ggplot2::theme_bw(
  )+
    theme(
      strip.background = element_rect(fill="grey90", color = NA)
    )
)
compute_epi_timeline <- function(d, n_deaths_first_day = 1) { #}, d_country ){
  # browser()
  # d <- ds_cgrt %>%
  #   # filter(country_code %in% c("ITA","FRA") ) %>%
  #   filter(country_code %in% c("AFG") ) %>%
  # select(country_code, date, n_cases, n_deaths)
  #
  d_out <- d %>%
    # dplyr::filter(country_code %in% unique(d_country$id)) %>%
    dplyr::group_by(country_code) %>%
    dplyr::mutate(
      # this solution might be vulnerable to cases where some intermediate dates are missed
      n_deaths_cum         = cumsum(tidyr::replace_na(n_deaths,0))
      ,n_cases_cum         = cumsum(tidyr::replace_na(n_cases,0))
      ,cutoff_death        = n_deaths_cum >= 1
      ,cutoff_case         = n_cases_cum >= 1
      ,days_since_1death   = cumsum(tidyr::replace_na(cutoff_death,0))
      ,days_since_1case    = cumsum(tidyr::replace_na(cutoff_case,0))
      ,date_of_1death      = lubridate::as_date(ifelse(days_since_1death==1,date, NA))
      ,date_of_1case       = lubridate::as_date(ifelse(days_since_1case==1,date, NA))
      ,date_of_1death      = min(date_of_1death, na.rm =T)
      ,date_of_1case       = min(date_of_1case, na.rm =T)
      ,days_since_1death   = date - date_of_1death
      ,days_since_1case    = date - date_of_1case
      ,n_deaths_cum_per_1m = n_deaths_cum/n_population_2018*1000000
      ,n_cases_cum_per_1m  = n_cases_cum/ n_population_2018*1000000
    ) %>%
    dplyr::ungroup() %>%
    # dplyr::filter(epi_timeline > 0) %>%
    dplyr::mutate(
      days_since_exodus    = as.integer(date - lubridate::date("2020-01-13")) # first case outside of china
      ,days_since_pandemic = as.integer(date - lubridate::date("2020-03-11")) # WHO declares pandemic
    ) %>%
    select(-cutoff_death, - cutoff_case, -date_of_1death, -date_of_1case)
  return(d_out)
}

# for testing the function:
# d_out <- ds0 %>%  filter(country_code == "ITA") %>%
#     select(
#       country_code, date,n_cases, n_deaths, ConfirmedDeaths, ConfirmedCases
#     ) %>%
#   compute_epi_timeline()
margings_for_plotly <- list(
  l = 50,
  r = 50,
  b = 100,
  t = 100,
  pad = 4
)

Data Sources

# reference table for geographic units (see ./manipulation/ellis-geography.R)
ds_geo <- readr::read_csv("./data-public/metadata/world-geography.csv")
# ds_geo %>% glimpse()

# COVID spread and mortality (see ./manipulation/ellis-covid.R)
ds_covid <- readr::read_csv(config$path_input_covid)
# ds_covid %>% glimpse()

# OxCGRT - COVID Government Response Tracker (see ./manipulation/ellis-cgrt.R)
ds_cgrt <- readr::read_rds("./data-unshared/derived/OxCGRT.rds")
# to keep it manageble during exploration
ds_cgrt <- ds_cgrt %>%  select(country_code, date, StringencyIndex,GovernmentResponseIndex,ContainmentHealthIndex,EconomicSupportIndex )
# ds_cgrt %>% glimpse()
ds0 <- ds_covid %>%
  compute_epi_timeline() %>%
  dplyr::left_join(
    ds_cgrt
    ,by = c("date", "country_code")
  ) %>%
  # filter(country_code %in% c("TUR", "ARM")) %>%
  # filter(date == date_i) %>%
  dplyr::left_join(
    ds_geo %>% select(-country_name, -country_number),
    by = c("country_code" )
  ) %>%
  filter(
    !is.na(country_label)
  )

# ds0 %>% glimpse()

Q0 - Response and Toll

What does Response to and Toll from COVID look for all OECD countries?

Response

# Why 75 days after exodus should be the starting point?
# 1. Most countries have peaked in their response
d1 <- ds0 %>% filter(oecd)
g1 <- ds0 %>%
  # filter(country_code == "ITA") %>%
  ggplot(aes(x = days_since_exodus, y = StringencyIndex, group = country_label, color = oecd))+
  geom_line( alpha = .2)+
  scale_color_manual(values = c("TRUE" = "darkorchid3", "FALSE" = "grey50"))+
  geom_point(data = d1 %>% filter(days_since_1case == 1), size = 2, fill = "#1b9e77", color = "black", alpha = .5, shape = 21)+
  geom_point(data = d1 %>% filter(days_since_1death == 1), size = 2, fill = "#d95f02", color = "black", alpha = .5, shape = 21)+
  scale_x_continuous(breaks = seq(0,100, 25))+
  labs(
    title = "Timeline of countries' respones to COVID-19 as measured by the Stringency Index"
    ,y = "Stringency Index", x = "Days since first case outside of China (Jan 13, 2020)"
  )+
  geom_vline(xintercept = 58, linetype = "dotted")+
  geom_vline(xintercept = 75, linetype = "dashed")+
  geom_vline(xintercept = 100, linetype = "dashed", color = "red")
margings_for_plotly <- list(
  l = 50,
  r = 50,
  b = 100,
  t = 100,
  pad = 4
)
g1 <- plotly::ggplotly(g1)
g1 %>% plotly::layout(autosize = F, width = 900, height = 600, margin = margings_for_plotly)

.
.
.
.
.
.

Toll

# 2. This is when the mortality curves starts going up
d2 <- ds0 %>% filter(oecd)
g2 <- ds0 %>%
  # filter(country_code %in% ds_country$id) %>%
  # filter(country_code == "ITA") %>%
  ggplot(aes(x = days_since_exodus, y = n_deaths_cum_per_1m, group = country_label, color = oecd))+
  geom_line( alpha = .2)+
  scale_color_manual(values = c("TRUE" = "darkorchid3", "FALSE" = "grey50"))+
  geom_point(data = d2 %>% filter(days_since_1case == 1), size = 2, fill = "#1b9e77", color = "black", alpha = .5, shape = 21)+
  geom_point(data = d2 %>% filter(days_since_1death == 1), size = 2, fill = "#d95f02", color = "black", alpha = .5, shape = 21)+
  scale_x_continuous(breaks = seq(0,100, 25))+
  labs(
    title = "Timeline of COVID-19 deaths per 1 million"
    ,y = "Total Deaths per 1 million", x = "Days since first case outside of China (Jan 13, 2020)"
  )+
  geom_vline(xintercept = 58, linetype = "dotted")+
  geom_vline(xintercept = 75, linetype = "dashed")+
  geom_vline(xintercept = 100, linetype = "dashed", color = "red")
margings_for_plotly <- list(
  l = 50,
  r = 50,
  b = 100,
  t = 100,
  pad = 4
)
g2 <- plotly::ggplotly(g2)
g2 %>% plotly::layout(autosize = F, width = 900, height = 600, margin = margings_for_plotly)
# g2 %>% plotly::layout(autosize = T)

.
.
.
.
.

Toll centered

# 3. Repositioning to the first death:
d3 <- ds0 %>% filter(oecd)
g3 <- ds0 %>%
  # filter(country_code == "ITA") %>%
  ggplot(aes(x = days_since_exodus, y = n_deaths_cum_per_1m, group = country_label, color = oecd))+
  geom_line( alpha = .2)+
  scale_color_manual(values = c("TRUE" = "darkorchid3", "FALSE" = "grey50"))+
  geom_point(data = d3 %>% filter(days_since_1case == 1), size = 2, fill = "#1b9e77", color = "black", alpha = .5, shape = 21)+
  geom_point(data = d3 %>% filter(days_since_1death == 1), size = 2, fill = "#d95f02", color = "black", alpha = .5, shape = 21)+
  scale_x_continuous(breaks = seq(-100,100, 25))+
  labs(
    title = "Timeline of COVID-19 deaths per 1 million (centered)"
    ,y = "Total Deaths (per 1 million)", x = "Days since first confirmed death in the country"
  )
margings_for_plotly <- list(
  l = 50,
  r = 50,
  b = 100,
  t = 100,
  pad = 4
)
g3 <- plotly::ggplotly(g3)
g3 %>% plotly::layout(autosize = F, width = 900, height = 600, margin = margings_for_plotly)
# g3 %>% plotly::layout(autosize = T)

.
.
.
.
.

Q1 - Shape of the trend

How does COVID-19 progress in each country?

# ds0 %>% glimpse()
d1 <- ds0 %>% filter(oecd) %>%
  mutate(
    n_cases_cum = n_cases_cum / 1000
    ,n_cases_cum_per_1m = n_cases_cum_per_1m / 1000
  )
g1 <- d1 %>%
  ggplot(aes(
    x = days_since_exodus
    ,y = n_cases_cum
    # ,y =n_cases_cum_per_1m
    # ,y = n_deaths_cum
    # ,y = n_deaths_cum_per_1m
  ))+
  geom_line(size = .5)+
  # geom_line(aes(y=StringencyIndex), color = "red")+
  facet_wrap(~country_label, scale = "free", ncol = 6)+
  geom_point(
    data = d1 %>% filter(days_since_1case == 1)
    ,size = 2, fill = "#1b9e77", color = "black", alpha = .5, shape = 21
  )+
  geom_point(
    data = d1 %>% filter(days_since_1death == 1)
    ,size = 2, fill = "#d95f02", color = "black", alpha = .5, shape = 21
  )+
  geom_vline(xintercept = 58, linetype = "dotted",)+
  geom_vline(xintercept = 75, linetype = "dashed", alpha = .5)+
  geom_vline(xintercept = 100, linetype = "dashed", color = "red", alpha = .5)+
  scale_x_continuous(breaks = seq(0,100, 50))+
  labs(
    title = "Timeline of COVID-19: Cumulative Cases"
    , y = "Cumulative Cases (in thousands)", x = "Days since first case outside of China (Jan 13, 2020)"
    , caption = "(first dot) = 1st confirmed case, (second dot) = 1st confirmed death,
    (dotted line) = pandemic announced by WHO, (dashed lines) = 75 and 100th day since Exodus"
  )
cat("\n## Cases\n")

Cases

g1

cat("\n## Cases per 1m\n")

Cases per 1m

g1 + aes(y = n_cases_cum_per_1m)+labs(y = "Cumulative Cases per 1 mil (in thousands)",
      title = "Timeline of COVID-19: Cumulative Cases per 1 million")

cat("\n## Deaths\n")

Deaths

g1 + aes(y = n_deaths_cum)+labs(y = "Cumulative Deaths",
  title = "Timeline of COVID-19: Cumulative Deaths")

cat("\n## Deaths per 1m\n")

Deaths per 1m

g1 + aes(y = n_deaths_cum_per_1m)+labs(y = "Cumulative Deaths per 1 mil",
   title = "Timeline of COVID-19: Cumulative Deaths per 1 million")

Q1 - Within Country

How do key indices compare within each country?

Common legend:

  • (first dot) = 1st confirmed case
  • (second dot) = 1st confirmed death
  • (dotted line) = pandemic announced by WHO (March 11)
  • (dashed lines) = 75th and 100th day since Exodus (January 13), first confirmed case outside China
  • X-asis measures Days since Exodus
# Q  How do key indices compare within each country?

focal_vars <- c( "n_cases_cum", "n_cases_cum_per_1m", "n_deaths_cum", "n_deaths_cum_per_1m",
                 "StringencyIndex")

ds1 <- ds0 %>%  filter(oecd) %>%
  # dplyr::filter(country_code %in% c("ITA","FRA")) %>%
  dplyr::select(country_code, country_label, days_since_exodus, days_since_1case,
                days_since_1death,
                n_cases_cum, n_cases_cum_per_1m, n_deaths_cum, n_deaths_cum_per_1m,
                StringencyIndex
  ) %>%
  tidyr::pivot_longer(cols = focal_vars, values_to = "value", names_to = "metric")

print_one_wrap <- function(d, country = "ITA"){
  # d <- ds1; country = "ITA"
  d1 <- d %>% filter(country_code == country) %>%
    dplyr::mutate(
      country_label = stringr::str_replace_all(country_label,"\\(the Republic of\\)","")
    )

  g1 <- d1 %>%
    ggplot(aes(x = days_since_exodus, y = value))+
    geom_line()+
    geom_point(
      data = d1 %>% filter(days_since_1case == 1),
      size = 2, fill = "#1b9e77", color = "black", alpha = .5, shape = 21)+
    geom_point(
      data = d1 %>% filter(days_since_1death == 1),
      size = 2, fill = "#d95f02", color = "black", alpha = .5, shape = 21)+
    geom_vline(xintercept = 58, linetype = "dotted",)+
    geom_vline(xintercept = 75, linetype = "dashed", alpha = .5)+
    geom_vline(xintercept = 100, linetype = "dashed", color = "red", alpha = .5)+
    facet_wrap(country_label ~ metric, scale = "free_y",ncol = 5,
               labeller = labeller(metric = c(
                 "n_cases_cum" = " Cases",
                 "n_cases_cum_per_1m" = " Cases per million",
                 "n_deaths_cum" = "Deaths",
                 "n_deaths_cum_per_1m" = "Deaths per million",
                 "StringencyIndex" = "Stringency Index"
               )))+
    labs(y = NULL, x = NULL)
  g1
}

# ds1 %>% print_one_wrap(country = 'ITA')

countries <- unique(ds1$country_code)
for(country_i in countries){
  # cat("\n#### ", country_i,"\n")
  ds1 %>% print_one_wrap(country = country_i) %>% print()
  cat("\n")
}

Q2 - Response

What was the trend of the response to COVID-10 by each country?

# What the trend response to COVID-10 by each country?

d1 <- ds0 %>% filter(oecd)
g1 <- d1 %>%
  ggplot(aes(x = days_since_exodus, y = StringencyIndex))+
  geom_line()+
  geom_point(data = d1 %>% filter(days_since_1case == 1), size = 2, fill = "#1b9e77", color = "black", alpha = .5, shape = 21)+
  geom_point(data = d1 %>% filter(days_since_1death == 1), size = 2, fill = "#d95f02", color = "black", alpha = .5, shape = 21)+
  facet_wrap(~country_label)+
  geom_vline(xintercept = 58, linetype = "dotted",)+
  geom_vline(xintercept = 75, linetype = "dashed", alpha = .5)+
  geom_vline(xintercept = 100, linetype = "dashed", color = "red", alpha = .5)+
  labs(
    title = "Timeline of OECD countries' respones to COVID-19 as measured by the Stringency Index"
    ,y = "Stringency Index", x = "Days since first case outside of China (Jan 13, 2020)"
    , caption = "(first dot) = 1st confirmed case, (second dot) = 1st confirmed death,
    (dotted line) = pandemic announced by WHO, (dashed lines) = 75 and 100th day since Exodus"
  )
cat("\n## Stringency\n")

Stringency

g1

cat("\n")
cat("\n## Government Response\n")

Government Response

g2 <- g1+aes(y = GovernmentResponseIndex)+labs(
  title = "Timeline of OECD countries' respones to COVID-19 as measured by the Government Response Index", y="Gov Response Index")
g2

cat("\n")
cat("\n## Containment\n")

Containment

g3 <- g1+aes(y = ContainmentHealthIndex)+labs(
  title = "Timeline of OECD countries' respones to COVID-19 as measured by the Containment  Index", y="Containment Index")
g3

cat("\n")
cat("\n## Economic Support\n")

Economic Support

g4 <- g1+aes(y = EconomicSupportIndex    )+labs(
  title = "Timeline of OECD countries' respones to COVID-19 as measured by the Economic Support  Index", y="Econ Support Index")
g4

session information

For the sake of documentation and reproducibility, the current report was rendered in the following environment. Click the line below to expand.

Environment

- Session info -------------------------------------------------------------------------------------------------------
 setting  value                       
 version  R version 3.6.3 (2020-02-29)
 os       Windows 10 x64              
 system   x86_64, mingw32             
 ui       RStudio                     
 language (EN)                        
 collate  English_United States.1252  
 ctype    English_United States.1252  
 tz       America/New_York            
 date     2020-05-29                  

- Packages -----------------------------------------------------------------------------------------------------------
 package      * version date       lib source        
 assertthat     0.2.1   2019-03-21 [1] CRAN (R 3.6.2)
 backports      1.1.5   2019-10-02 [1] CRAN (R 3.6.1)
 callr          3.4.3   2020-03-28 [1] CRAN (R 3.6.3)
 cli            2.0.2   2020-02-28 [1] CRAN (R 3.6.3)
 codetools      0.2-16  2018-12-24 [2] CRAN (R 3.6.3)
 colorspace     1.4-1   2019-03-18 [1] CRAN (R 3.6.1)
 config         0.3     2018-03-27 [1] CRAN (R 3.6.3)
 crayon         1.3.4   2017-09-16 [1] CRAN (R 3.6.2)
 crosstalk      1.0.0   2016-12-21 [1] CRAN (R 3.6.2)
 data.table     1.12.8  2019-12-09 [1] CRAN (R 3.6.2)
 desc           1.2.0   2018-05-01 [1] CRAN (R 3.6.2)
 devtools       2.3.0   2020-04-10 [1] CRAN (R 3.6.3)
 digest         0.6.25  2020-02-23 [1] CRAN (R 3.6.3)
 dplyr        * 0.8.5   2020-03-07 [1] CRAN (R 3.6.3)
 DT             0.13    2020-03-23 [1] CRAN (R 3.6.3)
 ellipsis       0.3.0   2019-09-20 [1] CRAN (R 3.6.2)
 evaluate       0.14    2019-05-28 [1] CRAN (R 3.6.2)
 fansi          0.4.1   2020-01-08 [1] CRAN (R 3.6.2)
 farver         2.0.3   2020-01-16 [1] CRAN (R 3.6.2)
 fastmap        1.0.1   2019-10-08 [1] CRAN (R 3.6.2)
 fs             1.3.1   2019-05-06 [1] CRAN (R 3.6.2)
 generics       0.0.2   2018-11-29 [1] CRAN (R 3.6.2)
 ggplot2      * 3.2.1   2019-08-10 [1] CRAN (R 3.6.2)
 glue           1.4.0   2020-04-03 [1] CRAN (R 3.6.3)
 gtable         0.3.0   2019-03-25 [1] CRAN (R 3.6.2)
 hms            0.5.3   2020-01-08 [1] CRAN (R 3.6.2)
 htmltools      0.4.0   2019-10-04 [1] CRAN (R 3.6.2)
 htmlwidgets    1.5.1   2019-10-08 [1] CRAN (R 3.6.2)
 httpuv         1.5.2   2019-09-11 [1] CRAN (R 3.6.2)
 httr           1.4.1   2019-08-05 [1] CRAN (R 3.6.2)
 jsonlite       1.6.1   2020-02-02 [1] CRAN (R 3.6.2)
 kableExtra   * 1.1.0   2019-03-16 [1] CRAN (R 3.6.3)
 knitr        * 1.28    2020-02-06 [1] CRAN (R 3.6.2)
 labeling       0.3     2014-08-23 [1] CRAN (R 3.6.0)
 later          1.0.0   2019-10-04 [1] CRAN (R 3.6.2)
 lazyeval       0.2.2   2019-03-15 [1] CRAN (R 3.6.2)
 lifecycle      0.2.0   2020-03-06 [1] CRAN (R 3.6.3)
 lubridate      1.7.8   2020-04-06 [1] CRAN (R 3.6.3)
 magrittr     * 1.5     2014-11-22 [1] CRAN (R 3.6.2)
 memoise        1.1.0   2017-04-21 [1] CRAN (R 3.6.2)
 mime           0.9     2020-02-04 [1] CRAN (R 3.6.2)
 munsell        0.5.0   2018-06-12 [1] CRAN (R 3.6.2)
 packrat        0.5.0   2018-11-14 [1] CRAN (R 3.6.2)
 pillar         1.4.3   2019-12-20 [1] CRAN (R 3.6.2)
 pkgbuild       1.0.6   2019-10-09 [1] CRAN (R 3.6.2)
 pkgconfig      2.0.3   2019-09-22 [1] CRAN (R 3.6.2)
 pkgload        1.0.2   2018-10-29 [1] CRAN (R 3.6.2)
 plotly         4.9.2   2020-02-12 [1] CRAN (R 3.6.2)
 prettyunits    1.1.1   2020-01-24 [1] CRAN (R 3.6.2)
 processx       3.4.2   2020-02-09 [1] CRAN (R 3.6.2)
 promises       1.1.0   2019-10-04 [1] CRAN (R 3.6.2)
 ps             1.3.2   2020-02-13 [1] CRAN (R 3.6.2)
 purrr          0.3.4   2020-04-17 [1] CRAN (R 3.6.3)
 R6             2.4.1   2019-11-12 [1] CRAN (R 3.6.2)
 RColorBrewer   1.1-2   2014-12-07 [1] CRAN (R 3.6.0)
 Rcpp           1.0.4.6 2020-04-09 [1] CRAN (R 3.6.3)
 readr          1.3.1   2018-12-21 [1] CRAN (R 3.6.2)
 remotes        2.1.1   2020-02-15 [1] CRAN (R 3.6.2)
 rlang          0.4.5   2020-03-01 [1] CRAN (R 3.6.3)
 rmarkdown    * 2.1     2020-01-20 [1] CRAN (R 3.6.2)
 rprojroot      1.3-2   2018-01-03 [1] CRAN (R 3.6.2)
 rstudioapi     0.11    2020-02-07 [1] CRAN (R 3.6.2)
 rvest          0.3.5   2019-11-08 [1] CRAN (R 3.6.2)
 scales         1.1.0   2019-11-18 [1] CRAN (R 3.6.2)
 sessioninfo    1.1.1   2018-11-05 [1] CRAN (R 3.6.2)
 shiny          1.4.0   2019-10-10 [1] CRAN (R 3.6.2)
 stringi        1.4.6   2020-02-17 [1] CRAN (R 3.6.2)
 stringr        1.4.0   2019-02-10 [1] CRAN (R 3.6.2)
 testthat       2.3.2   2020-03-02 [1] CRAN (R 3.6.3)
 tibble         3.0.1   2020-04-20 [1] CRAN (R 3.6.3)
 tidyr          1.0.2   2020-01-24 [1] CRAN (R 3.6.2)
 tidyselect     1.0.0   2020-01-27 [1] CRAN (R 3.6.2)
 usethis        1.6.0   2020-04-09 [1] CRAN (R 3.6.3)
 vctrs          0.2.4   2020-03-10 [1] CRAN (R 3.6.3)
 viridisLite    0.3.0   2018-02-01 [1] CRAN (R 3.6.2)
 webshot        0.5.2   2019-11-22 [1] CRAN (R 3.6.3)
 withr          2.1.2   2018-03-15 [1] CRAN (R 3.6.2)
 xfun           0.12    2020-01-13 [1] CRAN (R 3.6.2)
 xml2           1.2.2   2019-08-09 [1] CRAN (R 3.6.2)
 xtable         1.8-4   2019-04-21 [1] CRAN (R 3.6.2)
 yaml           2.2.1   2020-02-01 [1] CRAN (R 3.6.2)

[1] C:/Users/an499583/Documents/R/win-library/3.6
[2] C:/Users/an499583/Documents/R/R-3.6.3/library